home *** CD-ROM | disk | FTP | other *** search
/ Experimental BBS Explossion 3 / Experimental BBS Explossion III.iso / pascal / xlibpas.zip / DEMO8.PAS < prev    next >
Pascal/Delphi Source File  |  1993-10-22  |  3KB  |  120 lines
  1. Program demo8;
  2.  
  3. uses
  4.     Xlib, Dos, Crt;
  5.  
  6. const
  7.     swidth : array[0..9] of char =('0','1','2','3','4','5','6','7','8','9');
  8. var
  9.     fonts : array[0..19] of pointer;
  10.     names : array[0..19] of string;
  11.     i, fcount : integer;
  12.     c : char;
  13.  
  14. Type
  15.     Header = record
  16.         dummy : integer;
  17.         height, width : byte;
  18.     end;
  19.  
  20. procedure loaduserfonts;
  21. var
  22.     f : file;
  23.     len : word;
  24.     ASearchRec : SearchRec;
  25. begin
  26.     fcount := 0;
  27.     i := 0;
  28.     findfirst('*.fnt',AnyFile, ASearchRec);
  29.     if doserror<>0 then
  30.     begin
  31.         writeln('No Fonts found in current directory!');
  32.         halt(0);
  33.     end;
  34.     repeat
  35.         writeln('Loading font ', ASearchRec.name,'...');
  36.         names[fcount] := ASearchRec.name;
  37.         assign( f, names[fcount] );
  38.         reset(f,1);
  39.         len := filesize(f);
  40.         getmem(fonts[fcount],len);
  41.         if fonts[fcount] = nil then
  42.         begin
  43.             writeln('Out of memory');
  44.             halt(0);
  45.         end;
  46.         blockread(f,fonts[fcount]^,len);
  47.         close(f);
  48.         inc(fcount);
  49.         findnext(ASearchRec)
  50.     until doserror<>0;
  51.  
  52.     writeln('Press ''v'' to view, any other key to quit');
  53.     c:=readkey;
  54.     if (c<>'V') and (c<>'v') then
  55.     begin
  56.         xtextmode;
  57.         halt(0);
  58.     end;
  59.     xtextinit;
  60.     xsetmode(XMODE320x240,320);
  61.     xregisteruserfont(fonts[0]^);
  62.     xsetfont(2);
  63. end;
  64.  
  65. const
  66.     extract : array[0..15] of string =
  67.         ('EXTRACT: Stephen King''s ''SALEM''S LOT'' ',
  68.             '',
  69.             'The memory rose up in almost total    ',
  70.             'sensory reference, and for the moment ',
  71.             'of its totality he was paralyzed. He  ',
  72.             'could even smell the plaster and the  ',
  73.             'wild odour of nesting animals. It     ',
  74.             'seemed to him that the plain varnished',
  75.             'door of Matt Burke''s guest room stood ',
  76.             'between him and all the secrets of    ',
  77.             'Hell. Then he twisted the knob and    ',
  78.             'pushed the door handle inwards...     ',
  79.             '',
  80.             'ABCDEFGHIJKLMNOPQRSTUVWXYZ            ',
  81.             'abcdefghijklmnopqrstuvwxyz 0123456789 ',
  82.             '~!@#$%^&*()_+|`-=\\{}[]:\'';''<>?,./    ');
  83.  
  84.  
  85.  
  86.  
  87. var
  88.     textline, strindex, height : integer;
  89. begin
  90.     loaduserfonts;
  91.     for i:=0 to fcount-1 do
  92.     begin
  93.         xsetfont(FONT8x8);
  94.         xrectfill(0, 0, 319, 239, 0, 0);
  95.             xline(0,9,319,9,14,0);
  96.             xline(0,ScrnPhysicalHeight-10,319,ScrnPhysicalHeight-10,14,0);
  97.  
  98.             xprintf(0,0,0,14,'Font '+names[i]+' H=? W=?'{+
  99.                 intotstr(integer( (fonts[i]+2)^),
  100.                  ( *(fonts[i]+3)==0)?'Variable':swidth[*(fonts[i]+3)]});
  101.             xprintf(0,ScrnPhysicalHeight-8,0,14,'Press a key for next font...');
  102.             xregisteruserfont(fonts[i]^);
  103.             xsetfont(2);
  104.             height:=integer(ptr(seg(fonts[i]^),ofs(fonts[i]^)+2)^)+1;
  105.             textline:=12;
  106.             strindex:=0;
  107.             while strindex<16 do
  108.             begin
  109.              xprintf(0,textline,0,14,extract[strindex]);
  110.              inc(strindex);
  111.              textline:=textline+height;
  112.             end;
  113.  
  114.             readkey;
  115.     end;
  116.     xtextmode;
  117. end.
  118.  
  119.  
  120.